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¢ TOENT = '1=004' ' File: BASFETCHA.B32 Ed Mit: PEL 1004 
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'* ALL RIGHTS RESERVED. 
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FACILITY: BASIC Language Support 
ABSTRACT: 
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This module calculates the address of a non-virtual array 

element. It is called by the compiled code for the LOC 

function and for arrays passed as parameters. 
ENVIRONMENT: VAX-11 User Mode 
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AUTHOR: Pamela L. Levesque, CREATION DATE: 19-FEB-1982 
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4G 
boes 1-001 = Original. PLL 19-Feb-1982 — 
0046 1-002 - Add support for decimal arrays. This involves calculating the 
0047 size of elements in bytes (the length in the descriptor is the 
0048 number of digits not snc juding the sign). ang asin that length 
0049 to calculate the Linear index. PLL 12-Mar-1 
3930 1-003 - Offset for Ist index is 1, not 2. PLL Te cmare i982 
ith 1-004 = Return address of descriptor for dynamic strings. PLL 29-Mar-1982 
6088 
0054 !<BLF /PAGE> 
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BASSFETCH_ADDR 1-5 Sep-1984 t 90: $7 +36 Ax-11 Blis ait v4.0-7 4g 
i- 14-Sep p= 1986 4: BASRTL.SRCJBA FETCHA, 852;1 
$ g . 3s 
3 1 ! SWITCHES: 
i 088 1. 
3 o9 039 : SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
; ¢ 061 1! 
 & Bos 1 ! LINKAGES: 
>; 64 065 1! 
3 6 0064 1! NONE 
3; © 065 1! 
; 67 B98 1! 
; eB 06 : TABLE OF CONTENTS: 
; 9% 5 | 
oe 070 1 FORWARD ROUTINE 
3 g Oo) ; BASSFETCH_ADDR; ! Fetch address of array element 
; «676 $078 1! 
3; 0074 1 ! INCLUDE FILES: 
3; 0075 1! 
Po. We 0076 1 
3 4 BOF : REQUIRE ‘RTLIN:RTLPSECT’; ! Macros for defining psects 
; © $17 1 LIBRARY ‘RTLSTARLE'; ! System symbols 
3; 8 0174 #1 
3; § 0175 1! 
;. § g176 1 ! MACROS: 
; «BG 1g 8. 
3; 68S 0178 1! NONE 
; 86 0179 1! 
3 87 0180 1 ! EQUATED SYMBOLS: 
; «688 0181 1! 
; HET 7% NONE 
; 0183 1! 
; (91 0184 1 ! PSECTS: 
; F 0185 1! —e 
3 a2 B36 : DECLARE _PSECTS (BAS); ! Declare psects for BAS$ facility 
:. 0188 1 ! OWN STORAGE: 
; «696 0189 1! 
= or 0190 1! NONE 
; 0191 1! 
; 99 138 1 ! EXTERNAL REFERENCES: 
: 100 195 1! 
: 101 194 1 EXTERNAL ROUTINE 
3 106 B32 1 BASSS$STOP : NOVALUE; ! Signal fatal error 
: 104 5199 1 EXTERNAL LITERAL 
3; 105 198 1 BASSK_ARGDONMAT : Yas TENG? (8), 
: 106 199 1 BASSK_NOTIMP : UNSIGNED (8) 
3 107 00 1 BAS$K~SUBOUTRAN : UNSIGNED (8), 
: 108 1 1 BASSK_TOOFEWARG : UNSIGNED (8), 
; 4 § ' BASS$K_TOOMANARG : UNSIGNED (8); 
s 901 ; 02 1 
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14-Sep-1 BASRTL.SRCJBASFETCHA.B852;1 
13 GLOBAL ROUTINE BASSFETCH_ADDR ( ! Fetch address of array element 
14 DES 5 ! The descriptor 
15 INDEX1 ! First index 
18 : 
1 
18 ++ 
i FUNCTIONAL DESCRIPTION: 
1 Given a descriptor for the array and the indices, calculate 
¢ the address of an element. Take into account that this may 
be a FORTRAN array. This routine does not handle virtual 
: arrays. 
§ FORMAL PARAMETERS: 
8 DESCRIP.rx.da The descriptor of the array 
9 INDEX1.rl.v The first index into the array. More indicies 
. may follow this one in the calling sequence. 
¢ IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 


ROUTINE VALUE: 

The address of the element is returned 
COMPLETION CODES: 

NONE 
SIDE EFFECTS: 

Signals if an error is encountered. 
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ASSFETCH_ADDR -$ep-1984 00:27: AX-11 Bliss-32 V4.0-74 Pa 4 
ttf 13-08-1382 90:47:88 BASRTL. SRC BASFET teha b%2:1 = (3) 
129 6 LENGTH; 
: 17 
3 178 ge P DESCRIP : REF BLOCK (8, BYTE]; 
: 175 ef 
: 178 8 pe sure the number of array subscripts matches the number of 
: ie 9 ; _indicies given to us. 
: 179 7 
; 18} RE i (CACTUAL COUNT () = 1) NEQU .DESCRIP COSC$B_DIMCTI) 
; 188 rh EN BEGIN 
; 18 i 4 IF ((ACTUALCOUNT () = 1) LSSU .DESCRIP COSC$B_DIMCT}) 
; 186 i: =" BASSSSTOP (BAS$K_TOOFEWARG) 
: 188 80 BASSSSTOP (BASS$K_TOOMANARG); 
i OBE e: 
eee te ips 
; 138 0 Be 8 | “the coefficients and bounds must be present. 
: 195 028 
: 196 8 os IF ( NOT (.DESCRIP CDOSCS$V_FL_COEFF] AND .DESCRIP CDSC$V_FL_BOUNDS])) THEN BASSS$STOP (BASS$K_ARGDONMAT); 
: 198 0290 7 MULTIPLIERS = DESCRIP CDSC$L_M1); 
: ph 9 91 r BOUNDS = DESCRIP CDSCSL_M1) * (ZUPVAL*®.DESCRIP CDSC$B_DIMCT]); 
: 201 0 3 Compute the lower and upper index numbers based on how the array 
3 88 0294 is stored 
it oe an t* 
; 05 0297 IF (.DESCRIP CDSC$V_FL_COLUMN]) 
: 207 9299 
; 208 0 90 Ou. IhDeX = .DESCRIP COSC$B_DIMCT); 
; 209 8g 1 sa NDEX = 1; 
: 210 0 0¢ DER. INCR = -1; 
: 211 030 
3 i 0 Of ELSE 
+ 214 6 Peo. INDEX = 1; 
> 215 0 HIGA INDEX” = ‘DESCRIP COSC$B_DIMCT); 
3 16 $35 [oer z 1; 
g 1 09 
3 18 B39 
3 ih 0 sf INDEX_NUMBER = .LOW_INDEX = .INDEX_INCR; 
; $f SE i" Recompute decimal length if necessary. 
; 33 313 if jDESCRIP CDSCSB_DTYPE] EQL DSC$K_DTYPE_P 
; $6 b319 c_teNGTH = .DESCRIP CDSC$W_LENGTHI/2 + 1 
3; 226 0318 
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eam Mata) witLsunat rh 
te LENGTH = .DESCRIP CDSC$W_LENGTH); 
;_ Compute the Linear index from the indices provided. 
VALUE LOCATION = 0; 
WILE tt NOE _UMBER = .INDEX_NUMBER + .INDEX_INCR) NEQ (.HIGH_INDEX + .INDEX_INCR)) DO 
INDEX VALUE = ACTUALPARAMETER (.INDEX_NUMBER + 1); 


IF pe wo VALUE LSS .BOUNDS (C(.INDEX_NUMBER = 1)#2]) ! 
ne (. INDEX_VALUE GTR .BOUNDS C((.INDEX_NUMBER = 1)#2) + 1))) 


BASSS$STOP (BAS$K_SUBOUTRAN) ; 
canal = (.VALUE_LOCATION® MULTIPLIERS C.INDEX_NUMBER = 1]) * .INDEX_VALUE; 


VALUE LOCATION = (.VALUE_LOCATION*.LENGTH) + .DESCRIP CDSC$A_A0]; 
'¢ 


! Check for an array of descriptors. Fetch the address from the pointer 
! field of the descriptor if necessary. 


IF (.DESCRIP COSCSB_DTYPE] EQLU DSCSK_DTYPE_DSC) 
BEGIN 


VALUE_LOCATION : REF BLOCK (8, BYTE); 

IF .VALUE_LOCATION CDSCSB_DTYPE] NEQ DSC$K_DTYPE_T 
VALUE_ADDR = .VALUE_LOCATION CDSC$A_POINTER 
VALUE_ADDR = .VALUE_LOCATION; 


BEGIN 
VALUE_ADDR = .VALUE_LOCATION; 
END; 
IF (.DESCRIP CDSC$B_CLASS] NEQU DSCSK_CLASS_A) THEN BASS$$STOP (BASS$K_NOTIMP); 


RETURN .VALUE_ADDR; 
END; 


end of BASSFETCH_ADDR 
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-EXTRN 
»PSECT 
-ENTRY 


BASSK_TOOMANARG 
_BASSCODE,NOWRT, SHR, 


paseeerce ADDR, Save R2,R3,R4,R5,R6,R7,R8,- 
R9,R10,RIT 


BASSSS TOP, R11 
(ap), R 
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vO om 
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DD 
Oo 


pel hy ted peme tet pe | 
MMOD HOO - TW KHDRKOooreseo-—m 
oer = 
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ASSK_TOOFEWARG, =(SP) 


ASS$K_TOOMANARG, -(SP) 
. BASSSSTOP 
OCR6), 4$ 


NS 


AS$K_ARGDONMAT, =(SP) 
SS$SToP 
LTIPLIERS 


(R23, BOUNDS 
( 6$ 


ses 8 8 SO 
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#21 


INDEX NUMBER, R10 


_ 
4A 
#1, INDEX NOMB 
Nb 

1$ 
IND 

2s 
#BASSK SUBOUTRAN, =(SP) 
#1, BASSSSTOP 


CR, LOW_INDEX, INDEX_NUMBER 


r GH_INDEX, R10 
INDEX“INCR, INDEX_NUMBER 

P) CINDEX NUMBER] INDEX_VALUE 
EX_VALOE, of (BOUNDS) CRO} 
EX_VALUE, -4(BOUNDS) CROJ 
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AX-11 at PS -32 v4.0 
BASRTL. SRC JBASFETCHA. yf 


MULLS = =4(MULTIPLIERS)CINDEX_NUMBERJ, 
VALUE LOCATION 


A NDEX 
DpLS i oe 


8 
MULL bene wer 
ADDL 
CMPB ¢.0¢ 
BNEQ 4g 
CMPB (VAL 
BEQL 4% 


MOVL 4(VAL 
B 5$ 


ION, R 
“VALUE, RO, VALUE_LOCATION 


H. VALUE_LOCATION 
+ hd. VALUE AT DCATION 


UE_LOCATION), #14 
UE_LOCATION), VALUE_ADDR 


1 
MOVL VALUE. LOCATION, VALUE_ADDR 
CMPB (R6), #4 
BEQL 16$ 
MOVZBL #BASSK_NOTIMP, -(SP) 
CALLS #1, BASSSSTOP 
nove VALUE ADDR, RO 


! end of module BASSFETCH_ADDR 


50 53 FC A542 C5 OOOAS 12%: 
53 50 59 C1 000A 
gf fj a5 
29 é C5 B4 13$: 
1 A6 § B8 
1 0 A6é 91 000BD 
{' i C 
OE 02 Ads 9 C 
0 3 C 
52 04 AS OD c9 
9 11 CD 
52 3 CF 14$: 
04 03 ag 1 D2 15$: 
13 000D 
7E 00G 8F 9A 000D 
98 1 4 00DC 
0 2 dO OOODF 16$: 
04 000E2 
; Routine Size: 227 bytes, Routine Base: _BASS$CODE + 0000 
H $76 0368 1 
; ef 9369 1 END 
; 278 0370 1 
3 79 0371 O ELUDOM 
; PSECT SUMMARY 
: Name Bytes Attributes 
:  BASSCODE 227 NOVEC,NOWRT, RD, EXE, SHR, 
3 Library Statistics 
: ececeeece Symbols eosecece 
3 File Total Loaded Percent 
: _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 14 0 


COMMAND QUALIFIERS 


LCL, REL, 


Pages 
Mapped 


581 


CON, PIC,ALIGN(2) 


Processing 
Time 


00:01.1 


ASSFETCH_ADDR 18-Sep-1986 90:27: AX-11 Blisg-32 V4.0-7 Page 8 
Ve-$ep-1986 11:54:59 — EBASRIL“SRESBASFETCNA.BS2;1 an 


: BLISS/CHECK= (FIELD, INITIAL OPTIMIZE) /NOTRACE/LIS=LIS$:BASFETCHA/OBJ=0BJ$ :BASFETCHA MSRC$: BASF ETCHA/UPDATE=(ENHS$:BASFETCHA 


Size: 227 code + 0 data bytes 
: 00:0 


Elapsed Time: 216. 
Lines/CPU Min: 07 
Lexemes/CPU-Min: 15585 
mete Used: 103 pages 
Compilation Complete 
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